Language/OS - Multiplatform Resource Library/LANGUAGE OS.iso/scheme/pcscheme/geneva/sources.exe/SOURCES/EDWIN/MODELN.S

Text File | 1993-06-15 | 5.1 KB | 148 lines

;;;
;;;    Copyright (c) 1985 Massachusetts Institute of Technology
;;;
;;;    This material was developed by the Scheme project at the
;;;    Massachusetts Institute of Technology, Department of
;;;    Electrical Engineering and Computer Science.  Permission to
;;;    copy this software, to redistribute it, and to use it for any
;;;    purpose is granted, subject to the following restrictions and
;;;    understandings.
;;;
;;;    1. Any copy made of this software must include this copyright
;;;    notice in full.
;;;
;;;    2. Users of this software agree to make their best efforts (a)
;;;    to return to the MIT Scheme project any improvements or
;;;    extensions that they make, so that these may be included in
;;;    future releases; and (b) to inform MIT of noteworthy uses of
;;;    this software.
;;;
;;;    3.  All materials developed as a consequence of the use of
;;;    this software shall duly acknowledge such use, in accordance
;;;    with the usual standards of acknowledging credit in academic
;;;    research.
;;;
;;;    4. MIT has made no warrantee or representation that the
;;;    operation of this software will be error-free, and MIT is
;;;    under no obligation to provide any services, by way of
;;;    maintenance, update, or otherwise.
;;;
;;;    5.  In conjunction with products arising from the use of this
;;;    material, there shall be no use of the name of the
;;;    Massachusetts Institute of Technology nor of any adaptation
;;;    thereof in any advertising, promotional, or sales literature
;;;    without prior written consent from MIT in each case.
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;     Modified by Texas Instruments Inc 8/15/85
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; modeline messages
;012345678901234567890123456789012345678901234567890123456789012345678901234567
;PCS Edwin VVVVVVVVVV Filename for the rest of the line
; cols 78 and 79 are reserved for the modified stars
(begin
(define-integrable name-position 4)
(define-integrable version-position 11)
(define-integrable version-length 6)
(define-integrable mode-position 19)
(define-integrable file-name-position 35)
(define-integrable file-name-length 31)
(define-integrable modified-position 0)
(define-integrable buffer-position 17)
)

(define reset-modeline-window #F)
(define window-modeline-event! #F)
(define update-modeline! #F)

(letrec
 ((file-name #F)
  (file-name-changed #F)
  (version Edwin-Version)
  (modified #F)
  (modified-changed #F)
  (mode-changed #F)
  (mode-scheme? #T)
  (position-cursor
   (lambda (pos)
     (%reify-port! modeline-screen screen:cursor-x pos)))
  (string-upcase
   (lambda (string)
     (and string
     (let loop ((string1 (make-string (string-length string) #\space))
        (index 0) (end (string-length string)))
      (if (< index end)
          (begin
               (string-set! string1 index
                            (char-upcase (string-ref string index)))
               (loop string1 (1+ index) end))
              string1)))))
  (write-modified (lambda ()
            (set! modified-changed #F)
            (position-cursor modified-position)
            (princ (if modified "**" "  ") modeline-screen)))
  (write-mode (lambda ()
        (set! mode-changed #F)
        (position-cursor mode-position)
        (princ (if mode-scheme? "   [Scheme]    "
               " [Fundamental] ")
               modeline-screen)))
  (write-file-name (lambda ()
             (set! file-name-changed #F)
             (clear-subscreen! modeline-screen
                       file-name-position 0 0
                       file-name-length)
             (position-cursor file-name-position)
             (if file-name (princ file-name modeline-screen)))))

(set! reset-modeline-window
  (lambda ()
    (let ((buffer (current-buffer)))
      (set! modified (buffer-modified? buffer))
      (set! modified-changed #T)
      (set! file-name (string-upcase (buffer-pathname buffer)))
      (set! file-name-changed #T)
      (set! mode-scheme? *current-mode-scheme?*)
      (set! mode-changed #T)
      (%clear-window modeline-screen)
      (%reify-port! modeline-screen screen:cursor-y 0)
      (position-cursor name-position)
      (princ "Edwin" modeline-screen)
      (position-cursor version-position)
      (princ version modeline-screen)
;;;      (position-cursor buffer-position)
;;;      (princ " Buffer : Main " modeline-screen)
      (update-modeline!))))

(set! window-modeline-event!
  (lambda (window event)
    (let ((buffer (current-buffer)))
      (cond ((eq? event 'buffer-modified)
         (let ((buffer-modified (buffer-modified? buffer)))
               (if (not (eq? buffer-modified modified))
           (set! modified-changed #T))
           (set! modified buffer-modified)))
        ((eq? event 'buffer-pathname)
         (set! file-name-changed #T)
         (set! file-name (string-upcase (buffer-pathname buffer))))
        ((eq? event 'mode-changed)
         (set! mode-scheme? *current-mode-scheme?*)
         (set! mode-changed #T))
        (else #F)))))


(set! update-modeline!
  (lambda ()
    (if modified-changed (write-modified))
    (if file-name-changed (write-file-name))
    (if mode-changed (write-mode)))))